home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / docdem.arc / DLLTEST.PAS next >
Pascal/Delphi Source File  |  1991-07-20  |  4KB  |  155 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Pascal for Windows                     }
  4. {   Demo program                                 }
  5. {   Copyright (c) 1991 by Borland International  }
  6. {                                                }
  7. {************************************************}
  8.  
  9. program DLLTest;
  10.  
  11. {$R MATH}
  12.  
  13. uses WinTypes, WinProcs, WObjects, Math;
  14.  
  15. type
  16.   TMyApplication = Object(TApplication)
  17.     procedure InitMainWindow; Virtual;
  18.   end;
  19.  
  20.   TPaymentDlg = Object(TDialog)
  21.     Period, Interest, Term, Principal : Real;
  22.     function LoadFields: Boolean;
  23.     procedure OK(var Msg: TMessage); virtual id_First + IdOk;
  24.   end;
  25.  
  26.   TPrincipalDlg = Object(TDialog)
  27.     Payment, Period, Interest, Term: Real;
  28.     function LoadFields: Boolean;
  29.     procedure OK(var Msg: TMessage); virtual id_First + IdOk;
  30.   end;
  31.  
  32.   PMyWindow = ^TMyWindow;
  33.   TMyWindow = Object(TWindow)
  34.     PaymentDlg: TPaymentDlg;
  35.     PrincipalDlg: TPrincipalDlg;
  36.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  37.     procedure Payment(var Msg: TMessage); virtual cm_First + 201;
  38.     procedure Principal(var Msg: TMessage); virtual cm_First + 202;
  39.   end;
  40.  
  41. function TPaymentDlg.LoadFields: Boolean;
  42. var
  43.   E: Integer;
  44.   S: String;
  45. begin
  46.   LoadFields:=false;
  47.   S[0]:=Char(GetDlgItemText(HWindow, 104, @S[1], 20));
  48.   Val(S, Interest, E);
  49.   If E<>0 then
  50.     Exit;
  51.   S[0]:=Char(GetDlgItemText(HWindow, 105, @S[1], 20));
  52.   Val(S, Term, E);
  53.   If E<>0 then
  54.     Exit;
  55.   S[0]:=Char(GetDlgItemText(HWindow, 112, @S[1], 20));
  56.   Val(S, Period, E);
  57.   If E<>0 then
  58.     Exit;
  59.   S[0]:=Char(GetDlgItemText(HWindow, 106, @S[1], 20));
  60.   Val(S, Principal, E);
  61.   If E<>0 then
  62.     Exit;
  63.   LoadFields:=true;
  64. end;
  65.  
  66. procedure TPaymentDlg.Ok(var Msg: TMessage);
  67. var
  68.   S: String;
  69. begin
  70.   if not LoadFields then
  71.     WriteError(HWindow, 'All fields must have values')
  72.   else
  73.     begin
  74.       Str(Payments(Period, Interest, Term, Principal):10:2, S);
  75.       S:=S+#0;
  76.       While S[1]=' ' do
  77.     Delete(S, 1, 1);
  78.       SetDlgItemText(HWindow, 113, @S[1]);
  79.     end;
  80. end;
  81.  
  82. function TPrincipalDlg.LoadFields: Boolean;
  83. var
  84.   E: Integer;
  85.   S: String;
  86. begin
  87.   LoadFields:=false;
  88.   S[0]:=Char(GetDlgItemText(HWindow, 104, @S[1], 20));
  89.   Val(S, Interest, E);
  90.   If E<>0 then
  91.     Exit;
  92.   S[0]:=Char(GetDlgItemText(HWindow, 105, @S[1], 20));
  93.   Val(S, Term, E);
  94.   If E<>0 then
  95.     Exit;
  96.   S[0]:=Char(GetDlgItemText(HWindow, 112, @S[1], 20));
  97.   Val(S, Period, E);
  98.   If E<>0 then
  99.     Exit;
  100.   S[0]:=Char(GetDlgItemText(HWindow, 106, @S[1], 20));
  101.   Val(S, Payment, E);
  102.   If E<>0 then
  103.     Exit;
  104.   LoadFields:=true;
  105. end;
  106.  
  107. procedure TPrincipalDlg.Ok(var Msg: TMessage);
  108. var
  109.   S: String;
  110. begin
  111.   if not LoadFields then
  112.     WriteError(HWindow, 'All fields must have values')
  113.   else
  114.     begin
  115.       Str(Principals(Payment, Period, Interest, Term):10:2, S);
  116.       S:=S+#0;
  117.       While S[1]=' ' do
  118.     Delete(S, 1, 1);
  119.       SetDlgItemText(HWindow, 113, @S[1]);
  120.     end;
  121. end;
  122.  
  123. constructor TMyWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  124. begin
  125.   TWindow.Init(AParent, ATitle);
  126.   Attr.Menu := LoadMenu(HInstance, 'Menu');
  127. end;
  128.  
  129. procedure TMyWindow.Payment(var Msg: TMessage);
  130. begin
  131.   PaymentDlg.Init(@Self, 'PaymentDlg');
  132.   PaymentDlg.Execute;
  133.   PaymentDlg.Done;
  134. end;
  135.  
  136. procedure TMyWindow.Principal(var Msg: TMessage);
  137. begin
  138.   PrincipalDlg.Init(@Self, 'PrincipalDlg');
  139.   PrincipalDlg.Execute;
  140.   PrincipalDlg.Done;
  141. end;
  142.  
  143. procedure TMyApplication.InitMainWindow;
  144. begin
  145.   MainWindow:=New(PMyWindow, Init(nil, 'Title'));
  146. end;
  147.  
  148. var
  149.   MyApplication: TMyApplication;
  150. begin
  151.   MyApplication.Init('DLLTest');
  152.   MyApplication.Run;
  153.   MyApplication.Done;
  154. end.
  155.